home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
CFI_V607
/
CFITEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
10KB
|
259 lines
{$IFDEF Ver55}
{$R-,S+,A-,D-,L-}
{$ENDIF}
{$IFDEF Ver50}
{$R-,S+,A-,D-,L-}
{$ENDIF}
{$IFDEF Ver40}
{$R-,S+,D-}
{$ENDIF}
PROGRAM CFITest;
{******************************************************************************
* TestCFI is supplied to give you a view at most of CFI's functions, this is *
* a straightforward program. To let even the starting programmers read the *
* source easy, I have used no special tricks whatsoever. *
* You can modify the program to your own needs or better, you can use some of *
* the code as a setup for your own program ! *
******************************************************************************}
USES
Crt,Dos,{$IFDEF Ver40}T4CFI{$ENDIF}{$IFDEF Ver50}T5CFI{$ENDIF}{$IFDEF Ver55}T55CFI{$ENDIF};
VAR
InputP,InputT :STRING;
InputC :CHAR;
ArcRec :CIRTyp;
NewAtt :BYTE;
DatTim :DATETIME;
FUNCTION Compressed_Type(Attrib:BYTE):STRING;
{******************************************************************************
* Function to translate the CIRAtr byte into meaningfull text *
******************************************************************************}
BEGIN
CASE Attrib OF
1..2:Compressed_Type:='SEA stored)';
3 :Compressed_Type:='SEA packed)';
4 :Compressed_Type:='SEA Squeezed)';
5..8:Compressed_Type:='SEA Crunched)';
9 :Compressed_Type:='PKWare (old) Squashed)';
10 :Compressed_Type:='NoGate Crushed)';
11 :Compressed_Type:='NoGate Destilled)';
45 :Compressed_Type:='Nogate archive-comment)';
46 :Compressed_Type:='Nogate file-comment)';
47 :Compressed_Type:='Nogate file path )';
48 :Compressed_Type:='Nogate Security enveloppe)';
49 :Compressed_Type:='Nogate Error correction)';
50 :Compressed_Type:='ZIP (local header) Stored))';
51 :Compressed_Type:='ZIP (local header) Shrunk)';
52 :Compressed_Type:='ZIP (local header) Reduced-1)';
53 :Compressed_Type:='ZIP (local header) Reduced-2)';
54 :Compressed_Type:='ZIP (local header) Reduced-3)';
55 :Compressed_Type:='ZIP (local header) Reduced-4)';
56 :Compressed_Type:='ZIP (local header) Implodede';
80 :Compressed_Type:='ZIP (central header) Stored)';
81 :Compressed_Type:='ZIP (central header) Shrunk)';
82 :Compressed_Type:='ZIP (central header) Reduced-1)';
83 :Compressed_Type:='ZIP (central header) Reduced-2)';
84 :Compressed_Type:='ZIP (central header) Reduced-3)';
85 :Compressed_Type:='ZIP (central header) Reduced-4)';
86 :Compressed_Type:='ZIP (central header) Imploded';
99 :Compressed_Type:='ZIP End_of_central directory)';
100 :Compressed_Type:='ZOO Stored)';
101 :Compressed_Type:='ZOO LWZ compression)';
150 :Compressed_Type:='ZOO (deleted) Stored)';
151 :Compressed_Type:='ZOO (deleted) LWZ compression)';
200 :Compressed_Type:='ICE stored)';
201 :Compressed_Type:='ICE LZHufman)';
202 :Compressed_Type:='ICE/LZS -lz4-)';
203 :Compressed_Type:='ICE/LZS -lz5-)';
230 :Compressed_Type:='ICE/LZS -lz0-)';
231 :Compressed_Type:='ICE/LZS -lz1-)';
232 :Compressed_Type:='ICE/LZS -lz2-)';
234 :Compressed_Type:='ICE/LZS -lz3-)';
249 :Compressed_Type:='ICE/LZS -lz?-)';
255 :Compressed_Type:='DWC stored)';
251 :Compressed_Type:='DWC crunched)';
else Compressed_Type:='Unknown)';
END;
END;
PROCEDURE Print_Information;
{******************************************************************************
* Print the information obtained from CFI *
******************************************************************************}
BEGIN
ClrScr;
Writeln('Next Entry');
Writeln('-----------------------------------------------------------------------------');
Writeln('Attribute : ',ArcRec.CirAtr,' (',Compressed_Type(ArcRec.CirAtr));
Writeln('Internal flag 1 : ',ArcRec.CIRFl1);
Writeln('Internal flag 2 : ',ArcRec.CIRFl1);
Writeln('Filename : ',ArcRec.CIRNam);
Writeln('Path : ',ArcRec.CIRPth);
Writeln('Extra field : ',ArcRec.CIRExt);
Writeln('Description : ',ArcRec.CIRDes);
Writeln('Original size : ',ArcRec.CIROSi);
Writeln('Compressed size : ',ArcRec.CIRASi);
UnpackTime(ArcRec.CIRDTm,DatTim);
InputP:='Date : ';
Str(DatTim.Month,InputT);IF Length(InputT)=1 THEN InputT:='0'+InputT;
InputP:=InputP+InputT+'/';
Str(DatTim.Day,InputT); IF Length(InputT)=1 THEN InputT:='0'+InputT;
InputP:=InputP+InputT+'/';
Str(DatTim.Year,InputT);Delete(InputT,1,2);
InputP:=InputP+InputT+' Time : ';
Str(DatTim.Hour,InputT); IF Length(InputT)=1 THEN InputT:='0'+InputT;
InputP:=InputP+InputT+':';
Str(DatTim.Min,InputT); IF Length(InputT)=1 THEN InputT:='0'+InputT;
InputP:=InputP+InputT+':';
Str(DatTim.Sec,InputT); IF Length(InputT)=1 THEN InputT:='0'+InputT;
InputP:=InputP+InputT;
Writeln('Time/date : ',ArcRec.CIRDTm,' ',InputP);
Writeln('CRC : ',ArcRec.CIRCRC);
Writeln('File attribute : ',ArcRec.CIRFAt);
Writeln('Cum. orig. size : ',CFlOSi);
Writeln('Cum. comp. size : ',CFlASi);
Writeln('Zero-based start: ',ArcRec.CIRSpo);
Writeln('Lengt (hea+data): ',ArcRec.CIRLen);
TextColor(Yellow);
Write('Hit <ENTER> key to continue with next entry --> ');
TextColor(LightGray);
REPEAT InputC:=Readkey UNTIL InputC=#13;
END;
BEGIN
TextColor(LightGray);TextBackGround(Black);
ClrScr;
Writeln('TEST_CFI V 6.02 Test CFI interface (c) 1989 Robert W. van Hoeven/Nederland');
Writeln('-----------------------------------------------------------------------------');
Writeln;
Window(1,4,80,24);
Writeln('Testing copyrights and internal structure ... ');
Writeln;
TextColor(Cyan);
Writeln(CflCpy);
TextColor(LightGray);
Writeln;
Writeln('Current CFI version: ',CflVer);
Writeln;
TextColor(Yellow);
Write('Hit <ENTER> to continue --> ');
TextColor(LightGray);
REPEAT InputC:=ReadKey UNTIL InputC=#13;
ClrScr;
Write(#7,'--> Test the ');
TextColor(LightGreen);Write('NORMAL');TextColor(LightGray);
Writeln(' open function and list all entries of file <--');
Window(1,6,80,24);
REPEAT
ClrScr;
Writeln('Enter name (optional path) of a normal compressed file (no name to halt)');
Write('--> ');Readln(InputP);
IF InputP<>'' THEN BEGIN
IF Open_CFL(InputP) THEN BEGIN
WHILE Next_CFL(ArcRec) DO Print_Information;
Clos_CFL;
END ELSE BEGIN
TextColor(LightRed);
Writeln;
Writeln;
Writeln(#7,'File is not avaliable or no archive !');
Writeln;
TextColor(Yellow);
Write('Hit <ENTER> key to continue with next entry --> ');
TextColor(LightGray);
REPEAT InputC:=Readkey UNTIL InputC=#13;
END;
END;
UNTIL InputP='';
Window(1,4,80,24);
ClrScr;
Write(#7,'--> Test the ');
TextColor(LightRed);Write('FORCED');TextColor(LightGray);
Writeln(' open function and list all entries of file <--');
Window(1,6,80,24);
REPEAT
ClrScr;
Writeln('Enter name (optional path) of a normal compressed file (no name to halt)');
Write('--> ');Readln(InputP);
IF inputP<>'' THEN BEGIN
NewAtt:=Test_CFL(InputP);
IF NewAtt>0 THEN BEGIN
IF Forc_CFL(InputP,NewAtt) THEN BEGIN
WHILE Next_CFL(ArcRec) DO Print_Information;
Clos_CFL;
END ELSE BEGIN
TextColor(LightRed);
Writeln;
Writeln;
Writeln(#7,'File is not avaliable or no archive !');
Writeln;
TextColor(Yellow);
Write('Hit <ENTER> key to continue with next entry --> ');
TextColor(LightGray);
REPEAT InputC:=Readkey UNTIL InputC=#13;
END;
END ELSE BEGIN
TextColor(LightRed);
Writeln;
Writeln;
Writeln(#7,'File is not an archive supported by CFI or is invalid !');
Writeln;
TextColor(Yellow);
Write('Hit <ENTER> key to continue with next entry --> ');
TextColor(LightGray);
REPEAT InputC:=Readkey UNTIL InputC=#13;
END;
END;
UNTIL InputP='';
Window(1,4,80,24);
ClrScr;
Write(#7,'--> Test the ');
TextColor(Yellow);Write('LONG');TextColor(LightGray);
Writeln(' open function and list all entries of file <--');
Window(1,6,80,24);
{---------- For SXF testing and invalid headers set CflSFX to TRUE --------}
CFlSFX:=TRUE;
{--------------------------------------------------------------------------}
REPEAT
ClrScr;
Writeln('Enter name (optional path) of a normal compressed file (no name to halt)');
Write('--> ');Readln(InputP);
IF inputP<>'' THEN BEGIN
NewAtt:=Test_CFL(InputP);
IF NewAtt>0 THEN BEGIN
IF Forc_CFL(InputP,NewAtt) THEN BEGIN
WHILE Next_CFL(ArcRec) DO Print_Information;
Clos_CFL;
END ELSE BEGIN
TextColor(LightRed);
Writeln;
Writeln;
Writeln(#7,'File is not avaliable or no archive !');
Writeln;
TextColor(Yellow);
Write('Hit <ENTER> key to continue with next entry --> ');
TextColor(LightGray);
REPEAT InputC:=Readkey UNTIL InputC=#13;
END;
END ELSE BEGIN
TextColor(LightRed);
Writeln;
Writeln;
Writeln(#7,'File is not an archive supported by CFI or is invalid !');
Writeln;
TextColor(Yellow);
Write('Hit <ENTER> key to continue with next entry --> ');
TextColor(LightGray);
REPEAT InputC:=Readkey UNTIL InputC=#13;
END;
END;
UNTIL InputP='';
Window(1,1,80,25);
ClrScr;
Writeln('TestCFI ended !');
NormVideo;
END.